$include: 'flib.fi'
$include: 'flib.fd'

implicit real (a-h),(o-z)

        character  dialog*80, ttitle*80, pname*7
c
        character p$type*5(25),fspec*35
c
        real*8  diam(25),plen(25),pvert(25),prough(25)
        real*8  slope(25),slper(25),q(25),vel(25)
        integer*2 d1(25),ilun
c
        ifile = 0
        pi = 3.14159d0
        istat = ABOUTBOXQQ('Pipe Flow Calculator \r Version 1.0'C)
        ilun = 10
c
 10     open (UNIT = ilun, FILE = 'USER', TITLE = 'Pipe Chart Utility')
c
        dialog = 'Send results to ASCII file?'C
        ttitle = 'File Status'C
        istat = MESSAGEBOXQQ(dialog,ttitle,MB$YESNOCANCEL)
        if (istat .eq. 0)go to 900
        if (istat .eq. MB$IDYES) goto 20
        if (istat .eq. MB$IDNO) go to 30
        if (istat .eq. MB$IDCANCEL) go to 950
 20     continue
 21     format(a35)
        ifile = 1
        ilun = 20
        iret = 1
        open (UNIT = ilun, FILE = 'USER', TITLE = 'File Name Entry')
        dummy = FOCUSQQ(ilun)
 22     dialog = 'Enter file name:'
        write(ilun,*)dialog
        read(ilun,21,ERR = 700)fspec
        open (UNIT = 30, FILE = fspec, STATUS = 'unknown',
     +        access = 'sequential')
        close(ilun)
c
c       Get user input
c
 30     continue
        ilun = 10
        iret = 2
        dummy = FOCUSQQ(ilun)
 34     dialog = 'How many pipes'
        write(ilun,*)dialog
        read(ilun,*,ERR = 700)ipnum
        iret = 3
        do 39 ip = 1, ipnum, 1
 31     format('Pipe ',i2)
 32     format(a5)
 33     write(pname,31)ip
        write(ilun,*)pname
        dialog = 'Type of pipe (ex. CMP)?'
        write(ilun,*)dialog
        read(ilun,32,ERR = 700)p$type(ip)
        dialog = 'Diameter of pipe (in.):'
        write(ilun,*)dialog
        read(ilun,*, ERR = 700)d1(ip)
        diam(ip) = d1(ip)/12.0d0
        dialog = 'Length of pipe (ft.):'
        write(ilun,*)dialog
        read(ilun,*,ERR = 700)plen(ip)
        dialog = 'Vertical drop (ft.):'
        write(ilun,*)dialog
        read(ilun,*, ERR = 700)pvert(ip)
        dialog = 'Roughness coeff.:'
        write(ilun,*)dialog
        read(ilun,*, ERR = 700)prough(ip)
c
c       Calcs
c
        ra = diam(ip) / 2.0d0
        ax = pi * (ra**2)
        rx = ax /(diam(ip)*pi)
        slope(ip) = pvert(ip) / plen(ip)
        slper(ip) = slope(ip) * 100
        q(ip) = (1.486/prough(ip))*ax*(rx**(2.0d0/3.0d0))*
     +         (slope(ip)**(1.0d0/2.0d0))
        vel(ip) = q(ip) / ax
 39     continue
c
c       Show it
c
 40     continue
c
 41     format('Pipe # ',i2,' Type: ',i3,'in. ',a5)
 42     format('Length = ',f8.2,' ft.  Height = ',f8.2, ' Slope = ',
     +          f6.2,'%')
 43     format('Q (CFS) at full flow = ',f8.2)
 44     format('Flow Velocity (Ft./Sec.) = ',f8.2)
        ilun = 10
        ilun3 = 30
        do 49 ip = 1, ipnum, 1
        write(dialog,41)ip,d1(ip),p$type(ip)
        write(ilun,*)dialog
        if (ifile .eq. 1) write(ilun3,*)dialog
        write(dialog,42)plen(ip),pvert(ip),slper(ip)
        write(ilun,*)dialog
        if (ifile .eq. 1) write(ilun3,*)dialog
        write(dialog,43)q(ip)
        write(ilun,*)dialog
        if (ifile .eq. 1) write(ilun3,*)dialog
        write(dialog,44)vel(ip)
        write(ilun,*)dialog
        if (ifile .eq. 1) write(ilun3,*)dialog
        dialog = ' '
        write(ilun,*)dialog
        if (ifile .eq. 1) write(ilun3,*)dialog
 49     continue
        dialog = 'Pipe Chart Finished'C
 50     open (UNIT = ilun, FILE = 'USER', TITLE = dialog)
        dialog = 'Do another?'C
        ttitle = 'Decision time'C
        istat = MESSAGEBOXQQ(dialog,ttitle,MB$YESNOCANCEL)
        if (istat .eq. 0)go to 900
        if (istat .eq. MB$IDYES) goto 10
        if (istat .eq. MB$IDNO) go to 950
        if (istat .eq. MB$IDCANCEL) go to 950
 700    continue
c
        dialog = 'Keyboard entry error'
        write(ilun,*)dialog
        goto (22,34,33)iret
 850    continue
        dialog = 'File opening error'
        write(ilun,*)dialog
        go to 950
 900    continue
        dialog = 'Memory allocation error'
        write(ilun,*)dialog
 950    continue
        end


